(ns jna.win.user32
  (:use jna
        jna.win
        jna.win.kernel32)
  (:import [com.sun.jna Callback]))

;;;

(def SW_HIDE             0)
(def SW_SHOWNORMAL       1)
(def SW_NORMAL           1)
(def SW_SHOWMINIMIZED    2)
(def SW_SHOWMAXIMIZED    3)
(def SW_MAXIMIZE         3)
(def SW_SHOWNOACTIVATE   4)
(def SW_SHOW             5)
(def SW_MINIMIZE         6)
(def SW_SHOWMINNOACTIVE  7)
(def SW_SHOWNA           8)
(def SW_RESTORE          9)
(def SW_SHOWDEFAULT      10)
(def SW_FORCEMINIMIZE    11)
(def SW_MAX              11)

(def GWL_WNDPROC         -4)
(def GWL_HINSTANCE       -6)
(def GWL_HWNDPARENT      -8)
(def GWL_STYLE           -16)
(def GWL_EXSTYLE         -20)
(def GWL_USERDATA        -21)
(def GWL_ID              -12)

(def WM_SETFOCUS                     0x0007)
(def WM_KILLFOCUS                    0x0008)
(def WM_ENABLE                       0x000A)
(def WM_SETREDRAW                    0x000B)
(def WM_SETTEXT                      0x000C)
(def WM_GETTEXT                      0x000D)
(def WM_GETTEXTLENGTH                0x000E)
(def WM_PAINT                        0x000F)
(def WM_CLOSE                        0x0010)

(def WM_MOUSEFIRST                   0x0200)
(def WM_MOUSEMOVE                    0x0200)
(def WM_LBUTTONDOWN                  0x0201)
(def WM_LBUTTONUP                    0x0202)
(def WM_LBUTTONDBLCLK                0x0203)
(def WM_RBUTTONDOWN                  0x0204)
(def WM_RBUTTONUP                    0x0205)
(def WM_RBUTTONDBLCLK                0x0206)
(def WM_MBUTTONDOWN                  0x0207)
(def WM_MBUTTONUP                    0x0208)
(def WM_MBUTTONDBLCLK                0x0209)

(def MOUSEEVENTF_MOVE        0x0001) ; mouse move
(def MOUSEEVENTF_LEFTDOWN    0x0002) ; left button down
(def MOUSEEVENTF_LEFTUP      0x0004) ; left button up
(def MOUSEEVENTF_RIGHTDOWN   0x0008) ; right button down
(def MOUSEEVENTF_RIGHTUP     0x0010) ; right button up
(def MOUSEEVENTF_MIDDLEDOWN  0x0020) ; middle button down
(def MOUSEEVENTF_MIDDLEUP    0x0040) ; middle button up
(def MOUSEEVENTF_XDOWN       0x0080) ; x button down
(def MOUSEEVENTF_XUP         0x0100) ; x button down
(def MOUSEEVENTF_WHEEL       0x0800) ; wheel button rolled

(def MOUSEEVENTF_VIRTUALDESK 0x4000) ; map to entire virtual desktop */
(def MOUSEEVENTF_ABSOLUTE    0x8000) ; absolute move */

(def SM_CXSCREEN             0)
(def SM_CYSCREEN             1)

(def SMTO_NORMAL         0x0000)
(def SMTO_BLOCK          0x0001)
(def SMTO_ABORTIFHUNG    0x0002)


(def SWP_NOSIZE          0x0001)
(def SWP_NOMOVE          0x0002)
(def SWP_NOZORDER        0x0004)
(def SWP_NOREDRAW        0x0008)
(def SWP_NOACTIVATE      0x0010)
(def SWP_FRAMECHANGED    0x0020)
(def SWP_SHOWWINDOW      0x0040)
(def SWP_HIDEWINDOW      0x0080)
(def SWP_NOCOPYBITS      0x0100)
(def SWP_NOOWNERZORDER   0x0200)
(def SWP_NOSENDCHANGING  0x0400)

(def HWND_TOP        (native 0))
(def HWND_BOTTOM     (native 1))
(def HWND_TOPMOST    (native -1))
(def HWND_NOTOPMOST  (native -2))

(def SPIF_UPDATEINIFILE    0x0001)
(def SPIF_SENDWININICHANGE 0x0002)
(def SPIF_SENDCHANGE       SPIF_SENDWININICHANGE)

(def SPI_SETFOREGROUNDLOCKTIMEOUT        0x200)

;;;


(deflib- user32
  (int GetWindowTextW [:HWND :pointer int])
  (int GetClassNameW [:HWND :pointer int])

  (Boolean PostMessageW [:HWND int :native :native])
  (:native SendMessageW [:HWND int :native :native])
  (Integer RegisterWindowMessageW [com.sun.jna.WString])
  (:native SendMessageTimeoutW [:HWND Integer :native :native Integer Integer :pointer])

  (Boolean SetForegroundWindow [:HWND])

  (int GetWindowLongW [:HWND int])
  (Boolean GetWindowRect [:HWND :pointer])
  (Integer GetWindowThreadProcessId [:HWND :pointer])
  (Boolean SetWindowPos [:HWND :HWND int int int int int])

  (Boolean GetCaretPos [:pointer])

  (Boolean SystemParametersInfoW [int int :pointer int])
  (Boolean ShowWindowAsync [:HWND int]))

(defjna :HWND user32 GetDesktopWindow)
(defjna Boolean user32 EnumChildWindows)
(defjna Boolean user32 EnumWindows)
(defjna :HWND user32 GetParent)
(defjna Boolean user32 IsWindow)

(defjna Boolean user32 SetForegroundWindow)
(defjna :HWND user32 GetForegroundWindow)
(defjna Boolean user32 ShowWindow)
(defjna Boolean user32 IsIconic)
(defjna :HWND user32 SetActiveWindow)
(defjna Boolean user32 BringWindowToTop) ; XXX: not working?
(defjna Integer user32 GetSystemMetrics)
(defjna Void user32 mouse_event)

(defn PostMessage
  ([hWnd Msg wParam lParam]
    (.PostMessageW user32 hWnd Msg (native wParam) (native lParam)))
  ([hWnd Msg]
    (PostMessage hWnd Msg 0 0)))

(defn SendMessage
  ([hWnd Msg wParam lParam]
    (.SendMessageW user32 hWnd Msg (native wParam) (native lParam)))
  ([hWnd Msg]
    (SendMessage hWnd Msg 0 0)))

(defn RegisterWindowMessage [message]
  (.RegisterWindowMessageW user32 (com.sun.jna.WString. message)))

(defn SendMessageTimeout [hWnd Msg wParam lParam fuFlags uTimeout]
  (let [out (jna-new :native)]
    ; TODO: check SendMessageTimeoutW result
    (.SendMessageTimeoutW user32 hWnd Msg (native wParam) (native lParam) fuFlags uTimeout (address-of out))
    (jna-def out)))

(defcallback Boolean EnumWindowsProc [:native :native])


(defn GetChildWindows
  ([hwnd]
    (let [children (atom [])]
      (EnumChildWindows
        hwnd
        (callback EnumWindowsProc [hwnd lParam]
          (swap! children conj hwnd)
          true)
        (native 0))
      @children))
  ([]
    (GetChildWindows (GetDesktopWindow))))

(defn GetChildWindowTree [hwnd]
  (let [root hwnd
        children (GetChildWindows root)
        children-map (group-by GetParent children)]
    {:root root
     :children children-map
     :branch? children-map
     :seq (tree-seq children-map children-map root)}))

(defn GetDirectChildWindows [hwnd]
  (let [tree (GetChildWindowTree hwnd)]
    ((:children tree) (:root tree))))

(defn GetWindows []
  (let [windows (atom [])]
    (EnumWindows
      (callback EnumWindowsProc [hwnd lParam]
        (swap! windows conj hwnd)
        true)
      0)
    @windows))

(defn GetWindowText [hWnd] ; TODO: handle large text
  (let [n 255
        buffer (jna-array-new :WCHAR n)
        n (.GetWindowTextW user32 hWnd (address-of buffer) n)]
    (jna-to-string buffer n)))

(defn GetWindowLong [hWnd nIndex]
  (.GetWindowLongW user32 hWnd nIndex))

(defn GetWindowID [hWnd]
  (GetWindowLong hWnd GWL_ID)) ; control id

(defn GetClassName [hWnd] ; TODO: handle large text
  (let [n 255
        buffer (jna-array-new :WCHAR n)
        n (.GetClassNameW user32 hWnd (address-of buffer) n)]
    (jna-to-string buffer n)))


(defn GetChildDepth [hAncestor hChild]
  (loop [current hChild depth 1]
    (let [p (GetParent current)]
      (when (> depth 100)
        (throw (Exception. (str "Too many depth: " depth))))
      (cond
        (= hAncestor p) depth ; is it consistence with Win32::GuiTest?
        ;; XXX: is it correct to return depth when GetParent returns 0?
        (= p 0) depth;(throw (Exception. (str "Not a child window. GetLastError: " (GetLastError))))
        :else (recur p (inc depth))))))

(defn- is-window-like? [window text class id] ; TODO: id is not used
  (let [window-text (GetWindowText window)
        class-name (GetClassName window)]
    (if (or window text class id)
      (and (or (not text) (re-find text window-text))
           (or (not class) (re-find class class-name)))
      nil)))

(defn- to-re [s]
  (if (string? s)
    (re-pattern (java.util.regex.Pattern/quote s))
    s))

(defn- find-in-windows [windows text & [class id max-leval]] ; TODO: support id and max-level
  (let [text (to-re text)
        class (to-re class)]
    (filter #(is-window-like? % text class id) windows)))

(defn FindWindowLike ; TODO: support id and max-level
  ([window text & [class id max-level]]
    (find-in-windows (GetChildWindows (or window (GetDesktopWindow))) text class id max-level))
  ([text]
    (FindWindowLike nil text)))

(defn FindTopWindowLike [text & [class id max-level]]
  (find-in-windows (GetWindows) text class id max-level))

(defn GetWindowRect [hWnd]
  (let [rect (jna-struct-new RECT)]
    (.GetWindowRect user32 hWnd (byref rect))
    {:left (jna-struct-get :left rect)
     :top (jna-struct-get :top rect)
     :right (jna-struct-get :right rect)
     :bottom (jna-struct-get :bottom rect)}))


(defn GetWindowThreadProcessId [hWnd]
  (let [process-id (jna-new :DWORD)
        thread-id (.GetWindowThreadProcessId user32 hWnd (address-of process-id))]
      [thread-id (jna-def process-id)]))

(defn GetWindowThreadId [hWnd]
  (.GetWindowThreadProcessId user32 hWnd NULL))

(defn GetWindowProcessId [hWnd]
  (second (GetWindowThreadProcessId hWnd)))

(defn GetProcessTopWindows [pid]
  (filter #(= (GetWindowProcessId %) pid) (GetWindows)))

(use 'util.os)
(when (= (get-os) "Windows 7")
;  http://markribau.org/blog/2005/12/29/why-dont-focus-and-setforegroundwindow-work/
;  ::SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, (LPVOID)0, SPIF_SENDWININICHANGE | SPIF_UPDATEINIFILE);
;  ::ShowWindowAsync((HWND) window->Handle.ToPointer(), WS_SHOWNORMAL);
;  ::SetForegroundWindow((HWND) window->Handle.ToPointer());
;  ::SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 200000, (LPVOID)0, SPIF_SENDWININICHANGE | SPIF_UPDATEINIFILE);
  (def WS_SHOWNORMAL 1) ; XXX: where is the C header for WS_SHOWNORMAL?
  (defn SetForegroundWindow7 [hWnd] ; XXX: still not working!!! why???
    (.SystemParametersInfoW user32
      SPI_SETFOREGROUNDLOCKTIMEOUT
      0
      NULL
      (bit-or SPIF_SENDWININICHANGE SPIF_UPDATEINIFILE))
    (println "Updated SystemParametersInfo!")
    (try
      (.ShowWindowAsync user32 hWnd WS_SHOWNORMAL)
      (.SetForegroundWindow user32 hWnd)
      (finally
        (.SystemParametersInfoW user32
          SPI_SETFOREGROUNDLOCKTIMEOUT
          200000
          NULL
          (bit-or SPIF_SENDWININICHANGE SPIF_UPDATEINIFILE))))))

(defn SetWindowPos [hWnd hWndInsertAfter X Y cx cy uFlags]
  (.SetWindowPos user32 hWnd hWndInsertAfter X Y cx cy uFlags))

(defn BringToFront [hWnd] ; XXX: not working?
  (SetWindowPos hWnd HWND_TOP 0 0 0 0 (bit-or SWP_NOMOVE SWP_NOSIZE)))

(defjna Boolean user32 AttachThreadInput)

(defn GetCaretPos [] ; XXX: TODO: FIXME: not working...
  (let [point (jna-struct-new (jna-struct [:LONG :x] [:LONG :y]))
        result (.GetCaretPos user32 (address-of point))]
    {:x (jna-struct-get :x point)
     :y (jna-struct-get :y point)
     :result result}))


(defn- AttachWin [hwnd fAttach]
  (AttachThreadInput (GetWindowThreadId hwnd) (GetCurrentThreadId) (boolean fAttach)))

(defmacro with-hwnd-attach [hwnd & body]
  `(let [hwnd# ~hwnd]
    (AttachWin hwnd# true)
    (try
      ~@body
      (finally
        (AttachWin hwnd# false)))))

(defn GetCaretPos []
  (let [hwnd (GetForegroundWindow)
        point (jna-struct-new (jna-struct [:LONG :x] [:LONG :y]))
        result (with-hwnd-attach hwnd (.GetCaretPos user32 (address-of point)))]
    (when-not result
      (throw (Exception. "GetCaretPos returns false"))) ; TODO: check GetLastError
    {:x (jna-struct-get :x point)
     :y (jna-struct-get :y point)}))
